home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / eterm / tshell.el < prev    next >
Encoding:
Text File  |  1995-06-13  |  33.3 KB  |  815 lines

  1. ;;; tshell.el --- specialized term.el for running the shell.
  2.  
  3. ;; Copyright (C) 1988, 1993, 1994 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Per Bothner <bothner@cygnus.com>
  6. ;; Original comint version author: Olin Shivers <shivers@cs.cmu.edu>
  7. ;; Comint version maintainer: Simon Marshall <s.marshall@dcs.hull.ac.uk>
  8. ;; Keywords: processes
  9.  
  10. ;; This file is part of GNU Emacs.
  11.  
  12. ;; GNU Emacs is free software; you can redistribute it and/or modify
  13. ;; it under the terms of the GNU General Public License as published by
  14. ;; the Free Software Foundation; either version 2, or (at your option)
  15. ;; any later version.
  16.  
  17. ;; GNU Emacs is distributed in the hope that it will be useful,
  18. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20. ;; GNU General Public License for more details.
  21.  
  22. ;; You should have received a copy of the GNU General Public License
  23. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  24. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  25.  
  26. ;;; Commentary:
  27.  
  28. ;;; Please send me bug reports, bug fixes, and extensions, so that I can
  29. ;;; merge them into the master source.
  30. ;;;     - Olin Shivers (shivers@cs.cmu.edu)
  31. ;;;     - Simon Marshall (s.marshall@dcs.hull.ac.uk)
  32.  
  33. ;;; This file defines a a shell-in-a-buffer package (shell mode) built
  34. ;;; on top of term mode.  This is actually cmushell with things
  35. ;;; renamed to replace its counterpart in Emacs 18.  cmushell is more
  36. ;;; featureful, robust, and uniform than the Emacs 18 version.
  37.  
  38. ;;; Since this mode is built on top of the general command-interpreter-in-
  39. ;;; a-buffer mode (term mode), it shares a common base functionality, 
  40. ;;; and a common set of bindings, with all modes derived from term mode.
  41. ;;; This makes these modes easier to use.
  42.  
  43. ;;; For documentation on the functionality provided by term mode, and
  44. ;;; the hooks available for customising it, see the file term.el.
  45. ;;; For further information on shell mode, see the comments below.
  46.  
  47. ;;; Needs fixin:
  48. ;;; When sending text from a source file to a subprocess, the process-mark can 
  49. ;;; move off the window, so you can lose sight of the process interactions.
  50. ;;; Maybe I should ensure the process mark is in the window when I send
  51. ;;; text to the process? Switch selectable?
  52.  
  53. ;; YOUR .EMACS FILE
  54. ;;=============================================================================
  55. ;; Some suggestions for your .emacs file.
  56. ;;
  57. ;; ;; Define C-c t to run my favorite command in shell mode:
  58. ;; (setq tshell-mode-hook
  59. ;;       '((lambda () 
  60. ;;           (define-key tshell-mode-map "\C-ct" 'favorite-cmd))))
  61.  
  62.  
  63. ;;; Brief Command Documentation:
  64. ;;;============================================================================
  65. ;;; Term Mode Commands: (common to tshell and all term-derived modes)
  66. ;;;
  67. ;;; m-p        term-previous-input            Cycle backwards in input history
  68. ;;; m-n        term-next-input                  Cycle forwards
  69. ;;; m-r     term-previous-matching-input  Previous input matching a regexp
  70. ;;; m-R     term-previous-matching-input-from-input -"- matching input
  71. ;;; m-s     term-next-matching-input      Next input that matches
  72. ;;; m-S     term-next-matching-input-from-input     -"- matching input
  73. ;;; m-c-l   term-show-output            Show last batch of process output
  74. ;;; return  term-send-input
  75. ;;; c-c c-a term-bol                      Beginning of line; skip prompt
  76. ;;; c-d        term-delchar-or-maybe-eof        Delete char unless at end of buff.
  77. ;;; c-c c-u term-kill-input                ^u
  78. ;;; c-c c-w backward-kill-word            ^w
  79. ;;; c-c c-c term-interrupt-subjob         ^c
  80. ;;; c-c c-z term-stop-subjob                ^z
  81. ;;; c-c c-\ term-quit-subjob                ^\
  82. ;;; c-c c-o term-kill-output            Delete last batch of process output
  83. ;;; c-c c-r term-show-output            Show last batch of process output
  84. ;;; c-c c-h term-dynamic-list-input-ring    List input history
  85. ;;;         term-send-invisible             Read line w/o echo & send to proc
  86. ;;;         term-continue-subjob        Useful if you accidentally suspend
  87. ;;;                            top-level job
  88. ;;; term-mode-hook is the term mode hook.
  89.  
  90. ;;; Tshell Mode Commands:
  91. ;;;         tshell                Fires up the shell process
  92. ;;; tab     term-dynamic-complete        Complete filename/command/history
  93. ;;; m-?     term-dynamic-list-filename-completions List completions in help buffer
  94. ;;; m-c-f   tshell-forward-command           Forward a shell command
  95. ;;; m-c-b   tshell-backward-command          Backward a shell command
  96. ;;;         dirs                    Resync the buffer's dir stack
  97. ;;;         dirtrack-toggle                 Turn dir tracking on/off
  98. ;;;         tshell-strip-ctrl-m              Remove trailing ^Ms from output
  99. ;;;
  100. ;;; The tshell mode hook is tshell-mode-hook
  101. ;;; term-prompt-regexp is initialised to tshell-prompt-pattern, for backwards
  102. ;;; compatibility.
  103.  
  104. ;;; Read the rest of this file for more information.
  105.  
  106. ;;; SHELL.EL COMPATIBILITY
  107. ;;; Notes from when this was called cmushell, and was not the standard emacs
  108. ;;; shell package.
  109. ;;;============================================================================
  110. ;;; In brief: this package should have no trouble coexisting with shell.el.
  111. ;;; 
  112. ;;; Most customising variables -- e.g., explicit-shell-file-name -- are the
  113. ;;; same, so the users shouldn't have much trouble. Hooks have different
  114. ;;; names, however, so you can customise tshell mode differently from cmushell
  115. ;;; mode. You basically just have to remember to type M-x cmushell instead of
  116. ;;; M-x shell.
  117. ;;; 
  118. ;;; It would be nice if this file was completely plug-compatible with the old
  119. ;;; shell package -- if you could just name this file shell.el, and have it
  120. ;;; transparently replace the old one. But you can't.  Several other packages
  121. ;;; (tex-mode, background, dbx, gdb, kermit, monkey, prolog, telnet) are also
  122. ;;; clients of shell mode. These packages assume detailed knowledge of shell
  123. ;;; mode internals in ways that are incompatible with cmushell mode (mostly
  124. ;;; because of cmushell mode's greater functionality).  So, unless we are
  125. ;;; willing to port all of these packages, we can't have this file be a
  126. ;;; complete replacement for shell.el -- that is, we can't name this file
  127. ;;; shell.el, and its main entry point (shell), because dbx.el will break
  128. ;;; when it loads it in and tries to use it.
  129. ;;; 
  130. ;;; There are two ways to fix this. One: rewrite these other modes to use the
  131. ;;; new package. This is a win, but can't be assumed. The other, backwards
  132. ;;; compatible route, is to make this package non-conflict with shell.el, so
  133. ;;; both files can be loaded in at the same time. And *that* is why some
  134. ;;; functions and variables have different names: (cmushell),
  135. ;;; cmushell-mode-map, that sort of thing. All the names have been carefully
  136. ;;; chosen so that shell.el and cmushell.el won't tromp on each other.
  137.  
  138. ;;; Customization and Buffer Variables
  139. ;;; ===========================================================================
  140. ;;; 
  141.  
  142. ;;; Code:
  143.  
  144. (require 'term)
  145.  
  146. ;;;###autoload
  147. (defvar tshell-prompt-pattern "^[^#$%>\n]*[#$%>] *"
  148.   "Regexp to match prompts in the inferior shell.
  149. Defaults to \"^[^#$%>\\n]*[#$%>] *\", which works pretty well.
  150. This variable is used to initialise `term-prompt-regexp' in the 
  151. shell buffer.
  152.  
  153. The pattern should probably not match more than one line.  If it does,
  154. tshell-mode may become confused trying to distinguish prompt from input
  155. on lines which don't start with a prompt.
  156.  
  157. This is a fine thing to set in your `.emacs' file.")
  158.  
  159. (defvar tshell-completion-fignore nil
  160.   "*List of suffixes to be disregarded during file/command completion.
  161. This variable is used to initialize `term-completion-fignore' in the shell
  162. buffer.  The default is nil, for compatibility with most shells.
  163. Some people like (\"~\" \"#\" \"%\").
  164.  
  165. This is a fine thing to set in your `.emacs' file.")  
  166.  
  167. (defvar tshell-delimiter-argument-list '(?\| ?& ?< ?> ?\( ?\) ?\;)
  168.   "List of characters to recognise as separate arguments.
  169. This variable is used to initialize `term-delimiter-argument-list' in the
  170. shell buffer.  The default is (?\\| ?& ?< ?> ?\\( ?\\) ?\\;).
  171.  
  172. This is a fine thing to set in your `.emacs' file.")
  173.  
  174. (defvar tshell-dynamic-complete-functions
  175.   '(term-replace-by-expanded-history
  176.     tshell-dynamic-complete-environment-variable
  177.     tshell-dynamic-complete-command
  178.     tshell-replace-by-expanded-directory
  179.     term-dynamic-complete-filename)
  180.   "List of functions called to perform completion.
  181. This variable is used to initialise `term-dynamic-complete-functions' in the
  182. shell buffer.
  183.  
  184. This is a fine thing to set in your `.emacs' file.")
  185.  
  186. (defvar shell-command-regexp "[^;&|\n]+"
  187.   "*Regexp to match a single command within a pipeline.
  188. This is used for directory tracking and does not do a perfect job.")
  189.  
  190. (defvar shell-completion-execonly t
  191.   "*If non-nil, use executable files only for completion candidates.
  192. This mirrors the optional behavior of tcsh.
  193.  
  194. Detecting executability of files may slow command completion considerably.")
  195.  
  196. (defvar shell-popd-regexp "popd"
  197.   "*Regexp to match subshell commands equivalent to popd.")
  198.  
  199. (defvar shell-pushd-regexp "pushd"
  200.   "*Regexp to match subshell commands equivalent to pushd.")
  201.  
  202. (defvar shell-pushd-tohome nil
  203.   "*If non-nil, make pushd with no arg behave as \"pushd ~\" (like cd).
  204. This mirrors the optional behavior of tcsh.")
  205.  
  206. (defvar shell-pushd-dextract nil
  207.   "*If non-nil, make \"pushd +n\" pop the nth dir to the stack top.
  208. This mirrors the optional behavior of tcsh.")
  209.  
  210. (defvar shell-pushd-dunique nil
  211.   "*If non-nil, make pushd only add unique directories to the stack.
  212. This mirrors the optional behavior of tcsh.")
  213.  
  214. (defvar shell-cd-regexp "cd"
  215.   "*Regexp to match subshell commands equivalent to cd.")
  216.  
  217. ;; explicit-shell-file-name nil is in term.el.
  218.  
  219. (defvar explicit-csh-args
  220.   (if (eq system-type 'hpux)
  221.       ;; -T persuades HP's csh not to think it is smarter
  222.       ;; than us about what terminal modes to use.
  223.       '("-i" "-T")
  224.     '("-i"))
  225.   "*Args passed to inferior shell by M-x tshell, if the shell is csh.
  226. Value is a list of strings, which may be nil.")
  227.  
  228. (defvar tshell-input-autoexpand 'history
  229.   "*If non-nil, expand input command history references on completion.
  230. This mirrors the optional behavior of tcsh (its autoexpand and histlit).
  231.  
  232. If the value is `input', then the expansion is seen on input.
  233. If the value is `history', then the expansion is only when inserting
  234. into the buffer's input ring.  See also `term-magic-space' and
  235. `term-dynamic-complete'.
  236.  
  237. This variable supplies a default for `term-input-autoexpand',
  238. for Tshell mode only.")
  239.  
  240. (defvar tshell-dirstack nil
  241.   "List of directories saved by pushd in this buffer's shell.
  242. Thus, this does not include the shell's current directory.")
  243.  
  244. (defvar tshell-dirtrackp t
  245.   "Non-nil in a shell buffer means directory tracking is enabled.")
  246.  
  247. (defvar tshell-last-dir nil
  248.   "Keep track of last directory for ksh `cd -' command.")
  249.  
  250. (defvar tshell-dirstack-query nil
  251.   "Command used by `tshell-resync-dir' to query the shell.")
  252.  
  253. (defvar tshell-mode-map nil)
  254. (cond ((not tshell-mode-map)
  255.        (setq tshell-mode-map (copy-keymap term-mode-map))
  256.        (define-key tshell-mode-map "\C-c\C-f" 'tshell-forward-command)
  257.        (define-key tshell-mode-map "\C-c\C-b" 'tshell-backward-command)
  258.        (define-key tshell-mode-map "\t" 'term-dynamic-complete)
  259.        (define-key tshell-mode-map "\M-?"
  260.      'term-dynamic-list-filename-completions)
  261.        (define-key-after (lookup-key tshell-mode-map [menu-bar completion])
  262.      [complete-env-variable] '("Complete Env. Variable Name" .
  263.                    tshell-dynamic-complete-environment-variable)
  264.      'complete-file)
  265.        (define-key-after (lookup-key tshell-mode-map [menu-bar completion])
  266.      [expand-directory] '("Expand Directory Reference" .
  267.                   tshell-replace-by-expanded-directory)
  268.      'complete-expand)))
  269.  
  270. (defvar tshell-mode-hook '()
  271.   "*Hook for customising Tshell mode.")
  272.  
  273.  
  274. ;;; Basic Procedures
  275. ;;; ===========================================================================
  276. ;;;
  277.  
  278. (defun tshell-mode ()
  279.   "Major mode for interacting with an inferior shell.
  280. Return after the end of the process' output sends the text from the 
  281.     end of process to the end of the current line.
  282. Return before end of process output copies the current line (except
  283.     for the prompt) to the end of the buffer and sends it.
  284. M-x term-send-invisible reads a line of text without echoing it,
  285.     and sends it to the shell.  This is useful for entering passwords.
  286.  
  287. If you accidentally suspend your process, use \\[term-continue-subjob]
  288. to continue it.
  289.  
  290. cd, pushd and popd commands given to the shell are watched by Emacs to keep
  291. this buffer's default directory the same as the shell's working directory.
  292. M-x dirs queries the shell and resyncs Emacs' idea of what the current 
  293.     directory stack is.
  294. M-x dirtrack-toggle turns directory tracking on and off.
  295.  
  296. \\{tshell-mode-map}
  297. Customization: Entry to this mode runs the hooks on `term-mode-hook' and
  298. `tshell-mode-hook' (in that order).  Before each input, the hooks on
  299. `term-input-filter-functions' are run.
  300.  
  301. Variables `shell-cd-regexp', `shell-pushd-regexp' and `shell-popd-regexp'
  302. are used to match their respective commands, while `shell-pushd-tohome',
  303. `shell-pushd-dextract' and `shell-pushd-dunique' control the behavior of the
  304. relevant command.
  305.  
  306. Variables `term-completion-autolist', `term-completion-addsuffix',
  307. `term-completion-recexact' and `term-completion-fignore' control the
  308. behavior of file name, command name and variable name completion.  Variable
  309. `shell-completion-execonly' controls the behavior of command name completion.
  310. Variable `tshell-completion-fignore' is used to initialise the value of
  311. `term-completion-fignore'.
  312.  
  313. Variables `term-input-ring-file-name' and `term-input-autoexpand' control
  314. the initialisation of the input ring history, and history expansion.
  315.  
  316. Variables `term-output-filter-functions', a hook, and
  317. `term-scroll-to-bottom-on-input' and `term-scroll-to-bottom-on-output'
  318. control whether input and output cause the window to scroll to the end of the
  319. buffer."
  320.   (interactive)
  321.   (term-mode)
  322.   (setq major-mode 'tshell-mode)
  323.   (setq mode-name "Shell")
  324.   (use-local-map tshell-mode-map)
  325.   (setq term-prompt-regexp tshell-prompt-pattern)
  326.   (setq term-completion-fignore tshell-completion-fignore)
  327.   (setq term-delimiter-argument-list tshell-delimiter-argument-list)
  328.   (setq term-dynamic-complete-functions tshell-dynamic-complete-functions)
  329.   (make-local-variable 'paragraph-start)
  330.   (setq paragraph-start term-prompt-regexp)
  331.   (make-local-variable 'tshell-dirstack)
  332.   (setq tshell-dirstack nil)
  333.   (setq tshell-last-dir nil)
  334.   (make-local-variable 'tshell-dirtrackp)
  335.   (setq tshell-dirtrackp t)
  336.   (add-hook 'term-input-filter-functions 'tshell-directory-tracker)
  337.   (setq term-input-autoexpand tshell-input-autoexpand)
  338.   ;; shell-dependent assignments.
  339.   (let ((shell (file-name-nondirectory (car
  340.          (process-command (get-buffer-process (current-buffer)))))))
  341.     (setq term-input-ring-file-name
  342.       (or (getenv "HISTFILE")
  343.           (cond ((string-equal shell "bash") "~/.bash_history")
  344.             ((string-equal shell "ksh") "~/.sh_history")
  345.             (t "~/.history"))))
  346.     (if (equal term-input-ring-file-name "/dev/null")
  347.     (setq term-input-ring-file-name nil))
  348.     (setq tshell-dirstack-query
  349.       (if (string-match "^k?sh$" shell) "pwd" "dirs")))
  350.   (run-hooks 'tshell-mode-hook)
  351.   (term-read-input-ring t))
  352.  
  353. ;;;###autoload
  354. (defun tshell ()
  355.   "Run an inferior shell, with I/O through buffer *shell*.
  356. If buffer exists but shell process is not running, make new shell.
  357. If buffer exists and shell process is running, just switch to buffer `*shell*'.
  358. Program used comes from variable `explicit-shell-file-name',
  359.  or (if that is nil) from the ESHELL environment variable,
  360.  or else from SHELL if there is no ESHELL.
  361. If a file `~/.emacs_SHELLNAME' exists, it is given as initial input
  362.  (Note that this may lose due to a timing error if the shell
  363.   discards input when it starts up.)
  364. The buffer is put in Tshell mode, giving commands for sending input
  365. and controlling the subjobs of the shell.  See `tshell-mode'.
  366. See also the variable `tshell-prompt-pattern'.
  367.  
  368. The shell file name (sans directories) is used to make a symbol name
  369. such as `explicit-csh-args'.  If that symbol is a variable,
  370. its value is used as a list of arguments when invoking the shell.
  371. Otherwise, one argument `-i' is passed to the shell.
  372.  
  373. \(Type \\[describe-mode] in the shell buffer for a list of commands.)"
  374.   (interactive)
  375.   (if (not (term-check-proc "*shell*"))
  376.       (let* ((prog (or explicit-shell-file-name
  377.                (getenv "ESHELL")
  378.                (getenv "SHELL")
  379.                "/bin/sh"))             
  380.          (name (file-name-nondirectory prog))
  381.          (startfile (concat "~/.emacs_" name))
  382.          (xargs-name (intern-soft (concat "explicit-" name "-args"))))
  383.     (set-buffer (apply 'make-term "shell" prog
  384.                (if (file-exists-p startfile) startfile)
  385.                (if (and xargs-name (boundp xargs-name))
  386.                    (symbol-value xargs-name)
  387.                  '("-i"))))
  388.     (tshell-mode)))
  389.   (switch-to-buffer "*shell*"))
  390.  
  391. ;;; Directory tracking
  392. ;;; ===========================================================================
  393. ;;; This code provides the tshell mode input sentinel
  394. ;;;     TSHELL-DIRECTORY-TRACKER
  395. ;;; that tracks cd, pushd, and popd commands issued to the tshell, and
  396. ;;; changes the current directory of the tshell buffer accordingly.
  397. ;;;
  398. ;;; A better mechanism is now available:
  399. ;;; The standard term process filter supports a special escape command
  400. ;;;     \032 / <cwd> \n
  401. ;;; that the inferior can use to tell emacs what the current working
  402. ;;; directory is.
  403. ;;; All the inferior has to do is something like:
  404. ;;;     printf("\032/%s\n", PWD);
  405. ;;; Most modern shells can be programmed to emit this string easily.
  406. ;;; Hopefully, bash (at least) will be modified to do this automatically.
  407. ;;;
  408. ;;; So all this horrible directory-tracking machinary is now obsolete,
  409. ;;; but is kept at least until the standard GNU shells are modified
  410. ;;;
  411. ;;; This is basically a fragile hack, although it's more accurate than
  412. ;;; the version in Emacs 18's shell.el. It has the following failings:
  413. ;;; 1. It doesn't know about the cdpath shell variable.
  414. ;;; 2. It cannot infallibly deal with command sequences, though it does well
  415. ;;;    with these and with ignoring commands forked in another shell with ()s.
  416. ;;; 3. More generally, any complex command is going to throw it. Otherwise,
  417. ;;;    you'd have to build an entire shell interpreter in emacs lisp.  Failing
  418. ;;;    that, there's no way to catch shell commands where cd's are buried
  419. ;;;    inside conditional expressions, aliases, and so forth.
  420. ;;;
  421. ;;; The whole approach is a crock. Shell aliases mess it up. File sourcing
  422. ;;; messes it up. You run other processes under the shell; these each have
  423. ;;; separate working directories, and some have commands for manipulating
  424. ;;; their w.d.'s (e.g., the lcd command in ftp). Some of these programs have
  425. ;;; commands that do *not* affect the current w.d. at all, but look like they
  426. ;;; do (e.g., the cd command in ftp).  In shells that allow you job
  427. ;;; control, you can switch between jobs, all having different w.d.'s. So
  428. ;;; simply saying %3 can shift your w.d..
  429. ;;;
  430. ;;; The solution is to relax, not stress out about it, and settle for
  431. ;;; a hack that works pretty well in typical circumstances. Remember
  432. ;;; that a half-assed solution is more in keeping with the spirit of Unix, 
  433. ;;; anyway. Blech.
  434.  
  435. (defun tshell-directory-tracker (str)
  436.   "Tracks cd, pushd and popd commands issued to the shell.
  437. This function is called on each input passed to the shell.
  438. It watches for cd, pushd and popd commands and sets the buffer's
  439. default directory to track these commands.
  440.  
  441. You may toggle this tracking on and off with M-x dirtrack-toggle.
  442. If emacs gets confused, you can resync with the shell with M-x dirs.
  443.  
  444. See variables `shell-cd-regexp', `shell-pushd-regexp', and `shell-popd-regexp',
  445. while `shell-pushd-tohome', `shell-pushd-dextract' and `shell-pushd-dunique'
  446. control the behavior of the relevant command.
  447.  
  448. Environment variables are expanded, see function `substitute-in-file-name'."
  449.   (if tshell-dirtrackp
  450.       ;; We fail gracefully if we think the command will fail in the shell.
  451.       (condition-case chdir-failure
  452.       (let ((start (progn (string-match "^[;\\s ]*" str) ; skip whitespace
  453.                   (match-end 0)))
  454.         end cmd arg1)
  455.         (while (string-match shell-command-regexp str start)
  456.           (setq end (match-end 0)
  457.             cmd (term-arguments (substring str start end) 0 0)
  458.             arg1 (term-arguments (substring str start end) 1 1))
  459.           (cond ((eq (string-match shell-popd-regexp cmd) 0)
  460.              (tshell-process-popd (substitute-in-file-name arg1)))
  461.             ((eq (string-match shell-pushd-regexp cmd) 0)
  462.              (tshell-process-pushd (substitute-in-file-name arg1)))
  463.             ((eq (string-match shell-cd-regexp cmd) 0)
  464.              (tshell-process-cd (substitute-in-file-name arg1))))
  465.           (setq start (progn (string-match "[;\\s ]*" str end) ; skip again
  466.                  (match-end 0)))))
  467.     (error "Couldn't cd"))))
  468.  
  469. ;;; popd [+n]
  470. (defun tshell-process-popd (arg)
  471.   (let ((num (or (tshell-extract-num arg) 0)))
  472.     (cond ((and num (= num 0) tshell-dirstack)
  473.        (cd (car tshell-dirstack))
  474.        (setq tshell-dirstack (cdr tshell-dirstack))
  475.        (tshell-dirstack-message))
  476.       ((and num (> num 0) (<= num (length tshell-dirstack)))
  477.        (let* ((ds (cons nil tshell-dirstack))
  478.           (cell (nthcdr (1- num) ds)))
  479.          (rplacd cell (cdr (cdr cell)))
  480.          (setq tshell-dirstack (cdr ds))
  481.          (tshell-dirstack-message)))
  482.       (t
  483.        (error "Couldn't popd")))))
  484.  
  485. ;; Return DIR prefixed with term-file-name-prefix as appropriate.
  486. (defun tshell-prefixed-directory-name (dir)
  487.   (if (= (length term-file-name-prefix) 0)
  488.       dir
  489.     (if (file-name-absolute-p dir)
  490.     ;; The name is absolute, so prepend the prefix.
  491.     (concat term-file-name-prefix dir)
  492.       ;; For a relative name we assume default-directory already has the prefix.
  493.       (expand-file-name dir))))
  494.  
  495. ;;; cd [dir]
  496. (defun tshell-process-cd (arg)
  497.   (let ((new-dir (cond ((zerop (length arg)) (concat term-file-name-prefix
  498.                              "~"))
  499.                ((string-equal "-" arg) tshell-last-dir)
  500.                (t (tshell-prefixed-directory-name arg)))))
  501.     (setq tshell-last-dir default-directory)
  502.     (cd new-dir)
  503.     (tshell-dirstack-message)))
  504.  
  505. ;;; pushd [+n | dir]
  506. (defun tshell-process-pushd (arg)
  507.   (let ((num (tshell-extract-num arg)))
  508.     (cond ((zerop (length arg))
  509.        ;; no arg -- swap pwd and car of stack unless shell-pushd-tohome
  510.        (cond (shell-pushd-tohome
  511.           (shell-process-pushd (concat term-file-name-prefix "~")))
  512.          (tshell-dirstack
  513.           (let ((old default-directory))
  514.             (cd (car tshell-dirstack))
  515.             (setq tshell-dirstack
  516.               (cons old (cdr tshell-dirstack)))
  517.             (tshell-dirstack-message)))
  518.          (t
  519.           (message "Directory stack empty."))))
  520.       ((numberp num)
  521.        ;; pushd +n
  522.        (cond ((> num (length tshell-dirstack))
  523.           (message "Directory stack not that deep."))
  524.          ((= num 0)
  525.           (error (message "Couldn't cd.")))
  526.          (shell-pushd-dextract
  527.           (let ((dir (nth (1- num) tshell-dirstack)))
  528.             (tshell-process-popd arg)
  529.             (tshell-process-pushd default-directory)
  530.             (cd dir)
  531.             (tshell-dirstack-message)))
  532.          (t
  533.           (let* ((ds (cons default-directory tshell-dirstack))
  534.              (dslen (length ds))
  535.              (front (nthcdr num ds))
  536.              (back (reverse (nthcdr (- dslen num) (reverse ds))))
  537.              (new-ds (append front back)))
  538.             (cd (car new-ds))
  539.             (setq tshell-dirstack (cdr new-ds))
  540.             (tshell-dirstack-message)))))
  541.       (t
  542.        ;; pushd <dir>
  543.        (let ((old-wd default-directory))
  544.          (cd (tshell-prefixed-directory-name arg))
  545.          (if (or (null shell-pushd-dunique)
  546.              (not (member old-wd tshell-dirstack)))
  547.          (setq tshell-dirstack (cons old-wd tshell-dirstack)))
  548.          (tshell-dirstack-message))))))
  549.  
  550. ;; If STR is of the form +n, for n>0, return n. Otherwise, nil.
  551. (defun tshell-extract-num (str)
  552.   (and (string-match "^\\+[1-9][0-9]*$" str)
  553.        (string-to-int str)))
  554.  
  555.  
  556. (defun tshell-dirtrack-toggle ()
  557.   "Turn directory tracking on and off in a shell buffer."
  558.   (interactive)
  559.   (setq tshell-dirtrackp (not tshell-dirtrackp))
  560.   (message "Directory tracking %s" (if tshell-dirtrackp "ON" "OFF")))
  561.  
  562. ;;; For your typing convenience:
  563. (defalias 'dirtrack-toggle 'tshell-dirtrack-toggle)
  564.  
  565.  
  566. (defun tshell-resync-dirs ()
  567.   "Resync the buffer's idea of the current directory stack.
  568. This command queries the shell with the command bound to 
  569. `tshell-dirstack-query' (default \"dirs\"), reads the next
  570. line output and parses it to form the new directory stack.
  571. DON'T issue this command unless the buffer is at a shell prompt.
  572. Also, note that if some other subprocess decides to do output
  573. immediately after the query, its output will be taken as the
  574. new directory stack -- you lose. If this happens, just do the
  575. command again."
  576.   (interactive)
  577.   (let* ((proc (get-buffer-process (current-buffer)))
  578.      (pmark (process-mark proc)))
  579.     (goto-char pmark)
  580.     (insert tshell-dirstack-query) (insert "\n")
  581.     (sit-for 0) ; force redisplay
  582.     (term-send-string proc tshell-dirstack-query) 
  583.     (term-send-string proc "\n")
  584.     (set-marker pmark (point))
  585.     (let ((pt (point))) ; wait for 1 line
  586.       ;; This extra newline prevents the user's pending input from spoofing us.
  587.       (insert "\n") (backward-char 1)
  588.       (while (not (looking-at ".+\n"))
  589.     (accept-process-output proc)
  590.     (goto-char pt)))
  591.     (goto-char pmark) (delete-char 1) ; remove the extra newline
  592.     ;; That's the dirlist. grab it & parse it.
  593.     (let* ((dl (buffer-substring (match-beginning 0) (1- (match-end 0))))
  594.        (dl-len (length dl))
  595.        (ds '())            ; new dir stack
  596.        (i 0))
  597.       (while (< i dl-len)
  598.     ;; regexp = optional whitespace, (non-whitespace), optional whitespace
  599.     (string-match "\\s *\\(\\S +\\)\\s *" dl i) ; pick off next dir
  600.     (setq ds (cons (concat term-file-name-prefix
  601.                    (substring dl (match-beginning 1)
  602.                       (match-end 1)))
  603.                ds))
  604.     (setq i (match-end 0)))
  605.       (let ((ds (nreverse ds)))
  606.     (condition-case nil
  607.         (progn (cd (car ds))
  608.            (setq tshell-dirstack (cdr ds))
  609.            (tshell-dirstack-message))
  610.       (error (message "Couldn't cd.")))))))
  611.  
  612. ;;; For your typing convenience:
  613. (defalias 'dirs 'tshell-resync-dirs)
  614.  
  615.  
  616. ;;; Show the current dirstack on the message line.
  617. ;;; Pretty up dirs a bit by changing "/usr/jqr/foo" to "~/foo".
  618. ;;; (This isn't necessary if the dirlisting is generated with a simple "dirs".)
  619. ;;; All the commands that mung the buffer's dirstack finish by calling
  620. ;;; this guy.
  621. (defun tshell-dirstack-message ()
  622.   (let* ((msg "")
  623.      (ds (cons default-directory tshell-dirstack))
  624.      (home (expand-file-name (concat term-file-name-prefix "~/")))
  625.      (homelen (length home)))
  626.     (while ds
  627.       (let ((dir (car ds)))
  628.     (and (>= (length dir) homelen) (string= home (substring dir 0 homelen))
  629.         (setq dir (concat "~/" (substring dir homelen))))
  630.     ;; Strip off term-file-name-prefix if present.
  631.     (and term-file-name-prefix
  632.          (>= (length dir) (length term-file-name-prefix))
  633.          (string= term-file-name-prefix
  634.               (substring dir 0 (length term-file-name-prefix)))
  635.          (setq dir (substring dir (length term-file-name-prefix)))
  636.          (setcar ds dir))
  637.     (setq msg (concat msg (directory-file-name dir) " "))
  638.     (setq ds (cdr ds))))
  639.     (message msg)))
  640.  
  641. (defun tshell-forward-command (&optional arg)
  642.   "Move forward across ARG shell command(s).  Does not cross lines.
  643. See `shell-command-regexp'."
  644.   (interactive "p")
  645.   (let ((limit (save-excursion (end-of-line nil) (point))))
  646.     (if (re-search-forward (concat shell-command-regexp "\\([;&|][\t ]*\\)+")
  647.                limit 'move arg)
  648.     (skip-syntax-backward " "))))
  649.  
  650.  
  651. (defun tshell-backward-command (&optional arg)
  652.   "Move backward across ARG shell command(s).  Does not cross lines.
  653. See `shell-command-regexp'."
  654.   (interactive "p")
  655.   (let ((limit (save-excursion (term-bol nil) (point))))
  656.     (if (> limit (point))
  657.     (save-excursion (beginning-of-line) (setq limit (point))))
  658.     (skip-syntax-backward " " limit)
  659.     (if (re-search-backward
  660.      (format "[;&|]+[\t ]*\\(%s\\)" shell-command-regexp) limit 'move arg)
  661.     (progn (goto-char (match-beginning 1))
  662.            (skip-chars-forward ";&|")))))
  663.  
  664.  
  665. (defun tshell-dynamic-complete-command ()
  666.   "Dynamically complete the command at point.
  667. This function is similar to `term-dynamic-complete-filename', except that it
  668. searches `exec-path' (minus the trailing emacs library path) for completion
  669. candidates.  Note that this may not be the same as the shell's idea of the
  670. path.
  671.  
  672. Completion is dependent on the value of `shell-completion-execonly', plus
  673. those that effect file completion.  See `tshell-dynamic-complete-as-command'.
  674.  
  675. Returns t if successful."
  676.   (interactive)
  677.   (let ((filename (term-match-partial-filename)))
  678.     (if (and filename
  679.          (save-match-data (not (string-match "[~/]" filename)))
  680.          (eq (match-beginning 0)
  681.          (save-excursion (tshell-backward-command 1) (point))))
  682.     (prog2 (message "Completing command name...")
  683.         (tshell-dynamic-complete-as-command)))))
  684.  
  685.  
  686. (defun tshell-dynamic-complete-as-command ()
  687.   "Dynamically complete at point as a command.
  688. See `tshell-dynamic-complete-filename'.  Returns t if successful."
  689.   (let* ((filename (or (term-match-partial-filename) ""))
  690.      (pathnondir (file-name-nondirectory filename))
  691.      (paths (cdr (reverse exec-path)))
  692.      (cwd (file-name-as-directory (expand-file-name default-directory)))
  693.      (ignored-extensions
  694.       (and term-completion-fignore
  695.            (mapconcat (function (lambda (x) (concat (regexp-quote x) "$")))
  696.               term-completion-fignore "\\|")))
  697.      (path "") (comps-in-path ()) (file "") (filepath "") (completions ()))
  698.     ;; Go thru each path in the search path, finding completions.
  699.     (while paths
  700.       (setq path (file-name-as-directory (term-directory (or (car paths) ".")))
  701.         comps-in-path (and (file-accessible-directory-p path)
  702.                    (file-name-all-completions pathnondir path)))
  703.       ;; Go thru each completion found, to see whether it should be used.
  704.       (while comps-in-path
  705.     (setq file (car comps-in-path)
  706.           filepath (concat path file))
  707.     (if (and (not (member file completions))
  708.          (not (and ignored-extensions
  709.                (string-match ignored-extensions file)))
  710.          (or (string-equal path cwd)
  711.              (not (file-directory-p filepath)))
  712.          (or (null shell-completion-execonly)
  713.              (file-executable-p filepath)))
  714.         (setq completions (cons file completions)))
  715.     (setq comps-in-path (cdr comps-in-path)))
  716.       (setq paths (cdr paths)))
  717.     ;; OK, we've got a list of completions.
  718.     (let ((success (let ((term-completion-addsuffix nil))
  719.              (term-dynamic-simple-complete pathnondir completions))))
  720.       (if (and (memq success '(sole shortest)) term-completion-addsuffix
  721.            (not (file-directory-p (term-match-partial-filename))))
  722.       (insert " "))
  723.       success)))
  724.  
  725.  
  726. (defun tshell-match-partial-variable ()
  727.   "Return the variable at point, or nil if non is found."
  728.   (save-excursion
  729.     (let ((limit (point)))
  730.       (if (re-search-backward "[^A-Za-z0-9_{}]" nil 'move)
  731.       (or (looking-at "\\$") (forward-char 1)))
  732.       ;; Anchor the search forwards.
  733.       (if (or (eolp) (looking-at "[^A-Za-z0-9_{}$]"))
  734.       nil
  735.     (re-search-forward "\\$?{?[A-Za-z0-9_]*}?" limit)
  736.     (buffer-substring (match-beginning 0) (match-end 0))))))
  737.  
  738.  
  739. (defun tshell-dynamic-complete-environment-variable ()
  740.   "Dynamically complete the environment variable at point.
  741. Completes if after a variable, i.e., if it starts with a \"$\".
  742. See `tshell-dynamic-complete-as-environment-variable'.
  743.  
  744. This function is similar to `term-dynamic-complete-filename', except that it
  745. searches `process-environment' for completion candidates.  Note that this may
  746. not be the same as the interpreter's idea of variable names.  The main problem
  747. with this type of completion is that `process-environment' is the environment
  748. which Emacs started with.  Emacs does not track changes to the environment made
  749. by the interpreter.  Perhaps it would be more accurate if this function was
  750. called `tshell-dynamic-complete-process-environment-variable'.
  751.  
  752. Returns non-nil if successful."
  753.   (interactive)
  754.   (let ((variable (tshell-match-partial-variable)))
  755.     (if (and variable (string-match "^\\$" variable))
  756.     (prog2 (message "Completing variable name...")
  757.         (tshell-dynamic-complete-as-environment-variable)))))
  758.  
  759.  
  760. (defun tshell-dynamic-complete-as-environment-variable ()
  761.   "Dynamically complete at point as an environment variable.
  762. Used by `tshell-dynamic-complete-environment-variable'.
  763. Uses `term-dynamic-simple-complete'."
  764.   (let* ((var (or (tshell-match-partial-variable) ""))
  765.      (variable (substring var (or (string-match "[^$({]\\|$" var) 0)))
  766.      (variables (mapcar (function (lambda (x)
  767.                     (substring x 0 (string-match "=" x))))
  768.                 process-environment))
  769.      (addsuffix term-completion-addsuffix)
  770.      (term-completion-addsuffix nil)
  771.      (success (term-dynamic-simple-complete variable variables)))
  772.     (if (memq success '(sole shortest))
  773.     (let* ((var (tshell-match-partial-variable))
  774.            (variable (substring var (string-match "[^$({]" var)))
  775.            (protection (cond ((string-match "{" var) "}")
  776.                  ((string-match "(" var) ")")
  777.                  (t "")))
  778.            (suffix (cond ((null addsuffix) "")
  779.                  ((file-directory-p
  780.                    (term-directory (getenv variable))) "/")
  781.                  (t " "))))
  782.       (insert protection suffix)))
  783.     success))
  784.  
  785.  
  786. (defun tshell-replace-by-expanded-directory ()
  787.   "Expand directory stack reference before point.
  788. Directory stack references are of the form \"=digit\" or \"=-\".
  789. See `default-directory' and `tshell-dirstack'.
  790.  
  791. Returns t if successful."
  792.   (interactive)
  793.   (if (term-match-partial-filename)
  794.       (save-excursion
  795.     (goto-char (match-beginning 0))
  796.     (let ((stack (cons default-directory tshell-dirstack))
  797.           (index (cond ((looking-at "=-/?")
  798.                 (length tshell-dirstack))
  799.                ((looking-at "=\\([0-9]+\\)")
  800.                 (string-to-number
  801.                  (buffer-substring
  802.                   (match-beginning 1) (match-end 1)))))))
  803.       (cond ((null index)
  804.          nil)
  805.         ((>= index (length stack))
  806.          (error "Directory stack not that deep."))
  807.         (t
  808.          (replace-match (file-name-as-directory (nth index stack)) t t)
  809.          (message "Directory item: %d" index)
  810.          t))))))
  811.  
  812. (provide 'tshell)
  813.  
  814. ;;; tshell.el ends here
  815.